home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / LIBRARY / WAFPEGTP / TRIMLOG.PAS < prev    next >
Pascal/Delphi Source File  |  1994-01-16  |  6KB  |  234 lines
  1. {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  2. {$M 64000,32000,32000}
  3.  
  4. program trimlog;
  5. {
  6. takes an input file and trims the start to a length specified
  7. on the command line as a parameter.
  8. useful for trimming log files
  9.  
  10.     Copyright (C) 1992  Dr Ross Lazarus
  11.  
  12.     This program is free software; you can redistribute it and/or modify
  13.     it under the terms of the GNU General Public License as published by
  14.     the Free Software Foundation; either version 1.0, or (at your option)
  15.     any later version.
  16.  
  17.     This program is distributed in the hope that it will be useful,
  18.     but WITHOUT ANY WARRANTY; without even the implied warranty of
  19.     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20.     GNU General Public License for more details.
  21.  
  22.     You should have received a copy of the GNU General Public License
  23.     along with this program; if not, write to the Free Software
  24.     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  25.  
  26.     Dr Ross Lazarus is the original copyright holder of this code.
  27.     Email: rossl@gmu.wh.su.edu.au
  28.     Mail: Department of Community Medicine,
  29.           Westmead Hospital
  30.           Westmead, NSW 2145
  31.           Australia
  32.     Fax: (+61 2) 689 1049
  33.  
  34.  
  35.  
  36. rml January 1993
  37.  
  38. }
  39.  
  40. uses dos,crt;
  41.  
  42.  
  43. const
  44.      prog = 'TrimLog';
  45.      ver = '0.003,941601';
  46.      bufsize = 16767;   {**** can be bigger if you want... ****}
  47.      tempext = '.$`~'; { an unlikely file extension }
  48.      trimlength : longint = 32; { default trimmed size in kBytes }
  49.  
  50. type
  51.     tbuf = array[1..bufsize] of byte;
  52.  
  53. var
  54.    ifile,ofile : file ;
  55.    iname,oname,homedir,logdir,logfile,logext : string;
  56.    space,sifile : longint;
  57.    logdrive : integer;
  58.    ibuf : tbuf;
  59.    i : word;
  60.  
  61. Function SysDate : string;
  62. Var
  63.   d,m,y,dow : word;
  64.   Dd, Mm, Yy : String[4];
  65.   DT      : string;
  66.  
  67. Begin
  68.   getdate(y,m,d,dow);
  69.   Str(d:2, dd);
  70.   Str(m:2, mm);
  71.   Str(y:4, Yy);
  72.   DT := Dd + '/' + Mm + '/' +Yy;
  73.   for i := 1 to 10 do
  74.     if DT[I] = ' ' then
  75.       DT[I] := '0';
  76.   SysDate := DT
  77. End;
  78.  
  79. Function SysTime : String;
  80. Var
  81.   Hh, Mm, Ss : String[2];
  82.   h,m,s,s100 : word;
  83.  
  84. Begin
  85.   gettime(h,m,s,s100);
  86.   Str(H:2,hh);
  87.   Str(m:2,mm);
  88.   Str(s:2,ss);
  89.   if Hh[1] = ' ' then Hh[1] := '0';
  90.   if Mm[1] = ' ' then Mm[1] := '0';
  91.   if Ss[1] = ' ' then Ss[1] := '0';
  92.   SysTime := Hh + ':' + Mm + ':' + Ss;
  93. End;
  94.  
  95. procedure explain;
  96. {
  97. give instructions and halt
  98. }
  99.  
  100. begin
  101.      writeln(prog,' ',ver,', rossl@gmu.wh.su.edu.au');
  102.      writeln('**ERROR** ',sysdate,' at ',systime,' Probable Parameter error');
  103.      writeln('Need an input file path as the first parameter');
  104.      writeln('and a maximum length as the second');
  105.      writeln('eg trimlog c:\waffle\admin\uucico 32');
  106.      writeln('will trim uucico to a maximum length of 32k');
  107.      writeln('by discarding old material from the top of the file');
  108.      writeln('(c) Dr Ross Lazarus. This is FREE software. No fee may be charged');
  109.      writeln('for installation or use. Distribute for direct (materials) cost only.');
  110.      writeln('Please notify the author urgently if anyone ripped you off by charging');
  111.      writeln('any fee other than actual distribution costs.');
  112.      delay(1000);
  113.      chdir(homedir);
  114.      halt(1);
  115. end; { explain }
  116.  
  117. procedure init;
  118. {
  119. check params
  120. }
  121.  
  122. begin
  123.      if (paramcount = 0) then
  124.         explain;
  125.      if (paramcount > 1) then
  126.      begin
  127.           val(paramstr(2),trimlength,i);
  128.           if (i <> 0) then
  129.           begin
  130.                writeln('**ERROR - Non integer trim length specified (',paramstr(2),')**');
  131.                explain;
  132.           end;
  133.      end;
  134.      iname := paramstr(1);
  135.      {$i-}
  136.      assign(ifile,iname);
  137.      reset(ifile,1);
  138.      {$i+}
  139.      i := ioresult;
  140.      if (i <> 0) then
  141.      begin
  142.           writeln('**ERROR - Input file ',iname,' could not be opened**');
  143.           explain;
  144.      end;
  145.      fsplit(iname,logdir,logfile,logext);
  146.      {$i-}
  147.      chdir(logdir);
  148.      {$i+}
  149.      i := ioresult;
  150.      if (i <> 0) then
  151.      begin
  152.           close(ifile);
  153.           writeln('***ERROR - unable to change directory to ',logdir);
  154.           explain;
  155.      end;
  156.      space := diskfree(0);
  157.      if trimlength > space then
  158.      begin
  159.           close(ifile);
  160.           writeln('***ERROR - Insufficient disk space available to trim file ',iname);
  161.           writeln('Found ',space,', need ',trimlength);
  162.           explain;
  163.      end;
  164.      {$i-}
  165.      assign(ofile,logdir + logfile + tempext);
  166.      rewrite(ofile,1);
  167.      {$i+}
  168.      i := ioresult;
  169.      if (i <> 0) then
  170.      begin
  171.           close(ifile);
  172.           writeln('***ERROR - unable to open outfile ',logdir + logfile + tempext);
  173.           explain;
  174.      end;
  175. end; { init }
  176.  
  177. procedure docopy;
  178. {
  179. files are open
  180. copy trimlength bytes from end of ifile to ofile
  181. }
  182. var
  183.    toread,read : word;
  184.    fs,waste : longint;
  185.  
  186. begin
  187.      fs := filesize(ifile);
  188.      waste := fs - 1024*trimlength; { header length to trash }
  189.      if (waste > 0) then
  190.      begin
  191.           repeat { read all the stuff we need to delete to nowhere }
  192.                 if waste > sizeof(ibuf) then
  193.                    toread := sizeof(ibuf)
  194.                 else
  195.                     toread := waste;
  196.                 blockread(ifile,ibuf,toread,read);
  197.                 dec(waste,read);
  198.           until (waste <= 0);
  199.           repeat { now copy the rest to our output file }
  200.                 blockread(ifile,ibuf,sizeof(ibuf),read);
  201.                 blockwrite(ofile,ibuf,read);
  202.           until read = 0;
  203.           {$i-}
  204.           close(ifile);
  205.           i := ioresult;
  206.           close(ofile);
  207.           i := ioresult;
  208.           erase(ifile);
  209.           i := ioresult;
  210.           rename(ofile,iname);
  211.           i := ioresult;
  212.           {$i-};
  213.           writeln(prog,' ',sysdate,' at ',systime,' --> ',fs - 1024*trimlength,' bytes trimmed from file ',iname);
  214.      end
  215.      else
  216.      begin
  217.          writeln(prog,' ',sysdate,' at ',systime,' --> ',' Nothing done, ',iname,' only ',filesize(ifile) div 1024,'k long');
  218.          close(ifile);
  219.          close(ofile);
  220.          erase(ofile);
  221.      end;
  222. end;
  223.  
  224. begin { main }
  225.       getdir(0,homedir);
  226.       assign(input,'');
  227.       reset(input);
  228.       assign(output,'');
  229.       rewrite(output);
  230.       init;
  231.       docopy;
  232.       chdir(homedir);
  233. end.
  234. {trimlog.pas}